home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Almathera Ten Pack 3: CDPD 3
/
Almathera Ten on Ten - Disc 3: CDPD3.iso
/
scope
/
026-050
/
scopedisk39
/
chess
/
chess.basic
< prev
next >
Wrap
Text File
|
1995-03-18
|
21KB
|
1,171 lines
10
Print "Chess c.4 from "Creative Computing", Dec. 1981, page 276
Print "Rewritten for the Amiga by Douglas Bullard, 6-7-86
print "Compiled using the AC-Basic Compiler"
DEFINT a-z
DIM c(64),move(6,22),cols(8,8),pairs(6),length(6),strength(6)
a=0
b=0
x=0
y=0
s=0
a0=0
t=0
a8=0
a1=0
a2=0
a3=0
a4=0
b1=0
b6!=0
h=0
m=0
n=0
p=0
w=0
a5=0
i=1
for cunt=1 to 10000:next cunt
CLS
print "Do you want instructions? "
1101 in$=inkey$:if in$="" goto 1101
in$=UCASE$(in$)
print in$
IF in$="Y" THEN GOSUB 3170
cl$="N"
CLS
Input "What is your name";b$
IF b$="" THEN b$="Gomer " ELSE b$=LEFT$(b$,9)
CLS
input "Level of play (1-24)"; b8!
IF b8!=0 THEN
b8!=1
b7!=1+RND/2
ELSE
b7!=(b8!+1+RND)/2
END IF
CLS
print "Do you want white?"
1011 c$=inkey$:if c$="" goto 1011
c$=UCASE$(c$)
GOSUB 2590
flag1=1
IF c$<> "Y" THEN flag1=0:GOSUB 3430
CLS
print "Do you want to recall a previous game?"
1111 prev$=inkey$:if prev$="" goto 1111
prev$=UCASE$(prev$)
SCREEN 1,640,400,4,4
WINDOW 2, "AmigaChess",,15,1
PALETTE 0,0,.1,.03
PALETTE 1,.9,0,0
PALETTE 2,.8,0,0
PALETTE 3,.714,0,0
PALETTE 4,.571,0,0
PALETTE 5,.429,0,0
PALETTE 6,.228,0,0
PALETTE 7,.143,0,0
PALETTE 8,.1,.1,.1
PALETTE 9,0,0,.143
PALETTE 10,0,0,.228
PALETTE 11,0,0,.429
PALETTE 12,0,0,.571
PALETTE 13,0,0,.714
PALETTE 14,0,0,.8
PALETTE 15,0,0,.9
IF prev$<>"Y" THEN GOSUB 2840:GOTO 740
CLS
Input "What is the game name"; gamename$
gamename$="chess."+gamename$
PRINT "OK, saving ";gamename$;
OPEN "I",#1,gamename$
FOR al=1 TO 8
FOR be=1 TO 8
IF NOT EOF(1) THEN
INPUT #1,a(be,al)
ELSE
GOSUB 2840
GOTO 740
END IF
NEXT be,al
GOSUB 2840
GOTO 740
300 IF UCASE$(cl$)="Y" THEN
LOCATE 5,64
COLOR 4,8
PRINT "Start ";TIME$;
LOCATE 6,64
PRINT STRING$(14," ");
END IF
440 f!=-99
a0=0
FOR j=1 TO 8
FOR k=1 TO 8
IF a(j,k)=99 THEN a6=j:a7=k
NEXT k
NEXT j
FOR x=1 TO 8
FOR y=1 TO 8
IF a(x,y)<0 THEN
GOSUB 910
IF f!>=b7! THEN 580
END IF
NEXT y
NEXT x
IF f!>=-9 THEN 580 ELSE GOSUB 2840
LOCATE 4,64
PRINT "I concede"
GOTO 4230
580 a(r,u)=a(e,q)
a(e,q)=1
IF a(r,u)=-2 AND u=1 THEN a(r,u)=-9
x=r
y=u
a0=4
GOSUB 910
LINE (e*55-55,(190-q*24)*2)-STEP(54,24*2),1,b
LINE (r*55-55,(190-u*24)*2)-STEP(54,24*2),1,b
LOCATE 4,64
PRINT "is my move ";
LOCATE 3,64
PRINT CHR$(e+64);q;"- ";CHR$(r+64);u;
IF UCASE$(cl$)="Y" THEN LOCATE 6,64:PRINT "Stop ";TIME$;
x=e
y=q
GOSUB 2840
x=r
y=u
IF c=1 THEN
LOCATE 4,64
PRINT "Check";b$;
c=0
END IF
740 IF x$="S" THEN
GOSUB 3790
b7!=3*RND
LOCATE 1,64
PRINT "Self Playing";
GOSUB 4430
GOTO 440
ELSE
LOCATE 2,64
PRINT "Move ";b$;
GOSUB 3500
d=0
b4=a
b9=b
b5=0
IF a(x,y)=2 AND y=5 AND b=6 AND a(a,b)=1 AND ABS(a-x)=1 THEN
b5=1
GOTO 770
END IF
END IF
IF x$="K" OR x$="Q" THEN
GOSUB 2840
LOCATE 2,65
PRINT STRING$(14," ");
GOTO 440
END IF
IF x$="S" THEN
cl$="N"
GOTO 740
ELSE
a0=3
GOSUB 900
IF d=0 THEN
LOCATE 3,64
PRINT "Illegal";
GOTO 740
END IF
END IF
770 LOCATE 2,64: PRINT "OK ";
a=b4
b=b9
a(a,b)=a(x,y)
a(x,y)=1
GOSUB 2840
x=a
y=b
IF n$="N" THEN GOSUB 2840: n$=" "
IF a(a,b)=2 AND b=8 THEN
LOCATE 2,64
PRINT "What piece";
GOSUB 4350
x=a: y=b
GOSUB 2840
LOCATE 2,64
PRINT STRING$(14," ");
LOCATE 3,64
PRINT STRING$(14," ");
END IF
IF b5=1 THEN
a(a,b)=1
x=a
y=b-1
GOSUB 2840
END IF
890 GOTO 440
900 REM
ON a(x,y) GOTO 10,1520,10,1270,1070,10,920,10,1070: GOTO 1460
910 ON (-a(x,y)) GOTO 10,1640,10,1270,1070,10,920,10,1070: GOTO 1460
920 b=y
a=x+1
ender=8
940 GOSUB 2040
IF s=0 THEN
a=a+1
IF a<=ender THEN 940
END IF
a=x-1
ender=1
970 GOSUB 2040
IF s=0 THEN
a=a-1
IF a>=ender THEN 970
END IF
a=x
b=y+1
ender=8
1010 GOSUB 2040
IF s=0 THEN
b=b+1
IF b<=ender THEN 1010
END IF
b=y-1
ender=1
1040 GOSUB 2040
IF s=0 THEN
b=b-1
IF b>=ender THEN 1040
END IF
RETURN
1070 b=y
a=x+1
ender=8
1090 b=b+1
GOSUB 2040
IF s=0 THEN
a=a+1
IF a<=ender THEN 1090
END IF
b=y
a=x-1
ender=1
1140 b=b-1
GOSUB 2040
IF s=0 THEN
a=a-1
IF a>=ender THEN 1140
END IF
b=y
a=x-1
ender=1
1190 b=b+1
GOSUB 2040
IF s=0 THEN
a=a-1
IF a>=ender THEN 1190
END IF
b=y
a=x+1
ender=8
1231 b=b-1
GOSUB 2040
IF s=0 THEN
a=a+1
IF a<=ender THEN 1231
END IF
IF ABS(a(x,y))=9 THEN 920 ELSE RETURN
1270 a=x+2
b=y+1
IF a<9 AND b<9 THEN GOSUB 2060
b=b-2
IF b>0 AND a<9 THEN GOSUB 2060
a=a-4
IF a>0 AND b>0 THEN GOSUB 2060
b=b+2
IF b<9 AND a>0 THEN GOSUB 2060
a=a+1
b=b+1
IF a>0 AND a<9 AND b<9 THEN GOSUB 2060
b=b-4
IF b>0 AND a>0 AND a<9 THEN GOSUB 2060
a=a+2
IF a>0 AND a<9 AND b>0 THEN GOSUB 2060
b=b+4
IF b<9 AND a>0 AND a<9 THEN GOSUB 2060
RETURN
1460 FOR a=x-1 TO x+1
FOR b=y-1 TO y+1
IF a(a,b)<>0 THEN GOSUB 2060
NEXT
NEXT
RETURN
1520 a=x
IF y>2 THEN 1560
b=y+1
IF a(a,b)=1 THEN
GOSUB 2070
b=b+1
IF a(a,b)=1 THEN
GOSUB 2070
GOTO 1580
ELSE
GOTO 1580
END IF
ELSE
GOTO 1580
END IF
1560 b=y+1
IF a(a,b)=1 THEN GOSUB 2070
1580 a=x+1
b=y+1
IF a(a,b)<0 THEN GOSUB 2070
a=a-2
IF a(a,b)<0 THEN GOSUB 2070
RETURN
1640 a=x
IF y<7 THEN 1680
b=y-1
IF a(a,b)=1 THEN
GOSUB 2070
b=b-1
IF a(a,b)=1 THEN
GOSUB 2070
GOTO 1700
ELSE
GOTO 1700
END IF
ELSE
GOTO 1700
END IF
1680 b=y-1
IF a(a,b)=1 THEN GOSUB 2070
1700 a=x-1
b=y-1
IF a(a,b)>1 THEN GOSUB 2070
a=a+2
IF a(a,b)>1 THEN GOSUB 2070
RETURN
1760 t=a(a,b)
IF t=-99 THEN b1=t: RETURN
a5=s
IF ABS(t)<=a(x,y) THEN
a(a,b)=a(x,y)
a(x,y)=1
GOTO 1820
END IF
1800 IF t<b1 THEN b1=t
s=a5
RETURN
1820 a1=x
a2=y
a3=a
a4=b
a8=t
a0=2
FOR x=1 TO 8
FOR y= 1 TO 8
IF a(x,y)<0 THEN
GOSUB 910
IF t=0 THEN 1930
END IF
NEXT
NEXT
1930 x=a1
y=a2
a=a3
b=a4
a0=5
a(x,y)=a(a,b)
a(a,b)=a8
GOTO 1800
'*************************************************
'* This subroutine checks the legality of a move *
'*************************************************
2040 s=0
IF a(a,b)=1 THEN
GOTO 2070
ELSEIF a(a,b)=0 THEN
s=1
RETURN
ELSEIF SGN(a(a,b))=SGN(a(x,y)) THEN
s=1
RETURN
ELSE
s=1
GOTO 2070
END IF
2060 IF a(a,b)=1 THEN
GOTO 2070
ELSEIF SGN(a(a,b))=SGN(a(x,y)) THEN
RETURN
END IF
2070 REM
ON a0 GOTO 2090,2110,2130,2150,2170
GOTO 2180
2090 IF a6=a AND a7=b THEN b1=b1+1
RETURN
2110 IF a3=a AND a4=b THEN t=0
RETURN
2130 IF b4=a AND b9=b THEN d=1
RETURN
2150 IF a6=a AND a7=b THEN c=1
RETURN
2170 IF a(a,b)<0 THEN 1760 ELSE RETURN
2180 b3=s
w=x
m=y
n=a
h=b
p=a(a,b)
a(a,b)=a(x,y)
a(x,y)=1
b1=0
a0=5
FOR x=1 TO 8
FOR y=1 TO 8
IF a(x,y)>1 THEN GOSUB 900
NEXT y
NEXT x
x=n
y=h
a0=1
GOSUB 910
a0=0
s=b3
x=w
y=m
a=n
b=h
a(x,y)=a(a,b)
a(a,b)=p
b6!=1/(ABS(4.5-a)+ABS(4.5-b)+1)
IF a(x,y)<-2 AND a(x,y)>-9 THEN b6!=b6!+1/(ABS(a6-a)+ABS(a7-b)+5)+RND/15
g!=p+b1+b6!
IF p=99 THEN
GOSUB 2840
LOCATE 4,64
PRINT "Mate ";b$;
GOTO 4230
END IF
IF g!<=f! THEN RETURN
f!=g!
e=x
q=y
r=a
u=b
RETURN
'*********************************
'* Initialize positions on board *
'*********************************
2590 CLS
restore positionsdata
FOR y=1 TO 8
FOR x=1 TO 8
READ a(x,y)
NEXT x
NEXT y
Positionsdata:
DATA 7,4,5,9,99,5,4,7
DATA 2,2,2,2,2,2,2,2
DATA 1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1
DATA 1,1,1,1,1,1,1,1
DATA -2,-2,-2,-2,-2,-2,-2,-2
DATA -7,-4,-5,-9,-99,-5,-4,-7
movesdata:
' knight
DATA 8, 1,2, -1,-2, 2,1, 2,-1, -1,2, 1,-2, -2,-1, -2,1, 0,2
' castle
DATA 4, 8,0, -8,0, 0,8, 0,-8, 8,1
' Bishop
DATA 1, 8,8, 8,1
' Queen
DATA 5, 8,8, 8,0, 0,8, 0,-8, -8,0, 8,3
' King
DATA 8, 1,1, 1,-1, -1,1, -1,-1, 0,1, -1,0, 1,0, 0,-1, 0,1
' Pawn
DATA 4, 1,1, -1,1, 0,1, 0,2, 0,1
restore movesdata
FOR i=1 TO 6
READ pairs(i)
FOR j= 1 TO 2*pairs(i)
READ move(i,j)
NEXT j
READ length(i),strength(i)
NEXT i
RETURN
'**************************
'* Draws board and pieces *
'**************************
2840 FOR i=1 TO 8
FOR j=1 TO 8
cols(i,j)=0
NEXT
NEXT
FOR i=1 TO 8
FOR j=1 TO 8
IF a(i,j)=1 THEN GOTO 2737
pi=6
IF ABS(a(i,j))=4 THEN pi=1
IF ABS(a(i,j))=7 THEN pi=2
IF ABS(a(i,j))=5 THEN pi=3
IF ABS(a(i,j))=9 THEN pi=4
IF ABS(a(i,j))=99 THEN pi=5
cols(i,j)=cols(i,j)+strength(pi)*SGN(a(i,j))
FOR pair=1 TO pairs(pi)*2 STEP 2
x=move(pi,pair)+i
y=move(pi,pair+1)+j
IF a(i,j)=-2 THEN
x=i-move(pi,pair)
y=j-move(pi,pair+1)
END IF
stepx=1
IF x<i THEN stepx=-1
stepy=1
IF y<j THEN stepy=-1
IF x=i AND y=j THEN 2735
' pawn, king, or knight
IF length(pi)=0 THEN
IF pair>=6 THEN
IF a(i,j)=-2 AND j<>7 THEN 2735
IF a(i,j)=2 AND j<>2 THEN 2735
END IF
IF x<1 OR x>8 OR y<1 OR y>8 THEN 2735
cols(x,y)=cols(x,y)+strength(pi)*SGN(a(i,j))
ELSEIF move(pi,pair)=0 OR move(pi,pair+1)=0 THEN
FOR L=i TO x STEP stepx
FOR m=j TO y STEP stepy
IF L<1 OR L>8 OR m<1 OR m>8 THEN 2736
IF L=i AND m=j THEN
GOTO 2736
ELSE
cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j))
END IF
IF a(L,m)<>1 THEN GOTO 2735
2736 NEXT m
NEXT L
ELSE
' Diagonals
FOR ll=1 TO 8
L=i+ll
m=j+ll
IF L<9 AND m<9 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j))
IF a(L,m)<>1 THEN 2731
NEXT ll
2731 FOR ll=1 TO 8
L=i+ll
m=j-ll
IF L<9 AND m>0 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j))
IF a(L,m)<>1 THEN 2732
NEXT ll
2732 FOR ll=1 TO 8
L=i-ll
m=j+ll
IF L>0 AND m<9 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j))
IF a(L,m)<>1 THEN 2734
NEXT ll
2734 FOR ll=1 TO 8
L=i-ll
m=j-ll
IF L>0 AND m>0 THEN cols(L,m)=cols(L,m)+strength(pi)*SGN(a(i,j))
IF a(L,m)<>1 THEN 2735
NEXT ll
END IF
2735 NEXT pair
2737 NEXT j
NEXT i
FOR x=1 TO 8
FOR y=1 TO 8
GOSUB 2845
NEXT y
NEXT x
COLOR 5,0
RETURN
'****************************************************
'* Subroutine to draw a square and the piece on it. *
'* Square is identified by the coordinates x,y *
'****************************************************
2845 yc=y*24
xc=x*55
colors=(cols(x,y)+8)
IF colors >15 THEN colors=15
IF colors <1 THEN colors=1
LINE (xc-55,(190-yc)*2)-STEP(54,23*2),colors,bf
LINE (x*55-55,(190-y*24)*2)-STEP(54,24*2),0,b
IF SGN(a(x,y))=-1 THEN
COLOR 11,colors
Ccolor=11
ELSE
COLOR 5,colors
Ccolor=5
END IF
piece=ABS(a(x,y))
IF piece=7 THEN GOSUB rook
IF piece=4 THEN GOSUB knight
IF piece=5 THEN GOSUB bishop
IF piece=9 THEN GOSUB queen
IF piece=99 THEN GOSUB king
IF piece=2 THEN GOSUB pawn
COLOR 0,colors
RETURN
'****************
'* Instructions *
'****************
3170 CLS
Print " Welcome to the game of Amiga Chess."
Print
Print
Print
Print " There are a few differences between Amiga Chess and normal chess."
Print " These differences have to do with the way the board is displayed,"
Print " and the way the pieces are moved."
Print
Print " The board is a mosaic of different colors, all shades of red, "
Print " shades of blue, or completely black. The intensity of the shade indicates"
Print " which side dominates it the most, and to what degree. A bright red square"
Print " is heavily dominated by the red player,"
Print " while a dim red square may be only mildly dominated by red. "
Print " A square that appears black is equally dominated by both sides."
Print
Print
Print " To make a move, indicate the piece with a click of the left mouse "
Print " button, then indicate the square you want to move it to."
Print " Let the Amiga do the rest."
print
PRINT " Hit any key to continue"
WHILE INKEY$="":WEND
CLS
Print " 1. Special commands during player's move are:"
Print " 'K' - to castle king side."
Print " 'Q' - to castle queen side."
Print " 'X' - to exhange pieces and let the computer play."
Print " 'S' - to let the computer play by itself."
Print " 'M' - to modify the board and enter the square followed by 'C', 'P'"
Print " or 'E' for computer, player or empty and 'S', 'P', 'N', 'B',"
Print " 'R', 'Q', or 'K' for square, pawn,"
Print " knight, bishop, rook, queen, or king."
Print " 'Z' - to escape from modify and let the computer move."
Print " 'I' - to get instructions again."
Print " 'L' - to look at or change level of play."
Print " 2. To promote to P, N, B, R, or Q, enter the letter when prompted."
Print " 3. To capture 'en passant' specify the 'from' - 'to' squares."
Print " 4. Levels of play are from one to twenty four."
Print " 5. Computer assumes mate if king is left in check, so be sure to watch for"
Print " the check message."
Print " 6. If a move is illegal or an entry error is made,"
Print " simply type in a new move."
Print " A move may be started over by forcing an error. (i. e., '9')"
Print " 7. To record a game on disk for future playing, type an 'R'."
PRINT " Hit any key to continue and return to the game."
WHILE INKEY$="":WEND
RETURN
3430 i=-1
a(4,1)=99
a(5,1)=9
a(4,8)=-99
a(5,8)=-9
IF flag1=1 THEN GOSUB 2840
RETURN
3500 LOCATE 1,64: PRINT STRING$(14," ");
mou=MOUSE(0)
3510 x$=""
WHILE x$="" AND MOUSE(0)=0
x$=UCASE$(INKEY$)
WEND
FOR dgb=1 TO 2000
NEXT dgb
IF x$<>"" GOTO 3570
FOR ex=1 TO 8
IF MOUSE(1)>ex*55-55 AND MOUSE(1)<ex*55-1 THEN
x$=CHR$(ex+64)
x=ex
GOTO 3520
END IF
NEXT ex
3520 FOR why=1 TO 8
IF MOUSE(2)>(190-why*24)*2 AND MOUSE(2)<(214-why*24)*2 THEN
y=why
GOTO 3530
END IF
NEXT why
3530 LINE (x*55-55,(190-y*24)*2)-STEP(54,24*2),15,b
mou=MOUSE(0)
GOTO 3660
3570 IF x$="N" THEN n$=x$
IF x$="R" THEN
LOCATE 1,64
INPUT "What name";gamename$
gamename$="chess."+gamename$
PRINT gamename$;
OPEN gamename$ FOR OUTPUT AS #1
FOR al=1 TO 8
FOR be=1 TO 8
WRITE #1,a(be,al)
NEXT be,al
CLOSE #1
WINDOW CLOSE 2
CLS
END
END IF
IF x$="N" THEN 440
IF x$="K" AND a(5,1)=99 AND a(8,1)=7 THEN
a(5,1)=1
a(8,1)=1
a(7,1)=99
a(6,1)=7
GOTO 3750
END IF
IF x$="Q" AND a(5,1)=99 AND a(1,1)=7 THEN
a(5,1)=1
a(1,1)=1
a(3,1)=99
a(4,1)=7
GOTO 3750
END IF
IF x$="K" AND a(4,1)=99 AND a(1,1)=7 THEN
a(4,1)=1
a(1,1)=1
a(2,1)=99
a(3,1)=7
GOTO 3750
END IF
IF x$="Q" AND a(4,1)=99 AND a(8,1)=7 THEN
a(4,1)=1
a(8,1)=1
a(6,1)=99
a(5,1)=7
GOTO 3750
END IF
IF x$="X" THEN
GOSUB 3790
LOCATE 1,64
PRINT "Exchanging ";
GOSUB 4430
IF cl$="Y" THEN
LOCATE 5,60
PRINT "Start ";TIME$;
GOTO 440
ELSE
GOTO 440
END IF
END IF
IF x$="S" THEN 3780
IF x$="M" THEN GOSUB 3830
IF x$="I" THEN
GOSUB 3170
CLS
GOSUB 2840
LOCATE 1,64
PRINT "Move ";b$;
END IF
IF x$="L" THEN GOSUB 4140
GOTO 3510
3660 LOCATE 1,65: PRINT x$;
3670 LOCATE 1,66: PRINT y;
LOCATE 1,69: PRINT "-";
IF a(x,y)<2 OR a(x,y)>99 THEN
LOCATE 4,64
PRINT "Entry error ";
GOTO 3500
END IF
3710 WHILE MOUSE(0)=0:WEND
FOR ex=1 TO 8
IF MOUSE(1)>ex*55-55 AND MOUSE(1)<ex*55-1 THEN
a$=CHR$(ex+64)
a=ex
GOTO 3540
END IF
NEXT ex
3540 FOR why=1 TO 8
IF MOUSE(2)>(190-why*24)*2 AND MOUSE(2)<(214-why*24)*2 THEN
b=why
GOTO 3550
END IF
NEXT why
3550 LINE (a*55-55,(190-b*24)*2)-STEP(54,24*2),15,b
LOCATE 1,71:PRINT a$
LOCATE 1,72: PRINT b;
3750 IF x$="K" OR x$="Q" THEN
LOCATE 1,64
PRINT "Cstl. ";x$;"-side";
END IF
GOSUB 3790
IF cl$="Y" THEN
LOCATE 5,64
PRINT "Start ";TIME$;
END IF
3780 RETURN
3790 FOR j=2 TO 7
LOCATE j,64
PRINT STRING$(16," ");
NEXT j
RETURN
3830 GOSUB 3790
LOCATE 1,64: PRINT "Modifying ";
3850 GOSUB 4060
IF m$<"A" OR m$>"H" THEN 3850
x=VAL(CHR$(ASC(m$)-16))
LOCATE 2,64: PRINT m$;
3890 m$=INKEY$: IF m$<"1" OR m$>"8" THEN 3890
y=VAL(m$)
LOCATE 2,66: PRINT m$;" = ";
3920 m$=UCASE$(INKEY$)
IF m$="C" OR m$="P" OR m$="E" THEN
s1$=m$
LOCATE 2,70
PRINT m$;
ELSE
GOTO 3920
END IF
3930 m$=UCASE$(INKEY$):
IF m$="S" OR m$="P" OR m$="N" OR m$="B" OR m$="R" OR m$="Q" OR m$="K" THEN
v$=m$
LOCATE 2,72
PRINT m$;
ELSE
GOTO 3930
END IF
IF v$="P" THEN v1=2
IF v$="N" THEN v1=4
IF v$="B" THEN v1=5
IF v$="R" THEN v1=7
IF v$="Q" THEN v1=9
IF v$="K" THEN v1=99
IF v$="S" THEN v1=1
IF s1$="C" AND v1<>1 THEN v1=-v1
a(x,y)=v1
IF s1$="E" THEN a(x,y)=1
GOSUB 2840
GOTO 3830
4060 m$=UCASE$(INKEY$)
IF m$="N" THEN
GOTO 4060
ELSEIF m$="Z" THEN
GOSUB 3790
LOCATE 1,64
PRINT STRING$(14," ");
GOSUB 2840
ELSE
RETURN
END IF
IF cl$="Y" THEN LOCATE 5,60: PRINT "Start ";TIME$;
GOTO 440
4140 GOSUB 3790
LOCATE 1,64: PRINT "Level=";b8!;" ";
LOCATE 2,64: PRINT"Change levels?";
4170 c$=UCASE$(INKEY$)
IF c$="N" THEN
GOTO 4225
ELSEIF c$="Y" THEN
LOCATE 1,71
PRINT STRING$(7," ");
GOSUB 3790
ELSE
GOTO 4170
END IF
4180 l1$=INKEY$
IF l1$="" THEN
GOTO 4180
ELSEIF l1$>="0" AND l1$<"9" THEN
LOCATE 1,71
PRINT l1$
ELSE
GOTO 4180
END IF
4190 l2$=INKEY$
IF l2$="" THEN
GOTO 4190
ELSEIF l2$<"0" OR l2$>"9" THEN
l2$=l1$
l1$="0"
END IF
b8!=VAL(l1$)*10+VAL(l2$)
b7!=b8!/2
LOCATE 1,71: PRINT l1$;l2$;
4225 GOSUB 3790
LOCATE 1,64
PRINT STRING$(14," ");
LOCATE 2,64
PRINT "Move ";b$;
RETURN
4230 IF cl$="Y" THEN LOCATE 6,64: PRINT "Stop ";TIME$;
LOCATE 9,62: PRINT "Hit 'P' to play";
LOCATE 10,62: PRINT "or 'B' for basic";
4260 a$=UCASE$(INKEY$)
IF a$="" THEN
GOTO 4260
ELSEIF a$="B" THEN
CLS
END
ELSEIF a$="P" THEN
GOTO 10
ELSE
GOTO 4260
END IF
GOSUB 3790
LOCATE 1,64: PRINT STRING$(14," ");
LOCATE 2,64: PRINT "Move ";b$;
RETURN
'*********************
'* Promotion routine *
'*********************
4350 LOCATE 3,64: PRINT "P, N, B, R, Q";
4360 z$=UCASE$(INKEY$)
IF z$="P" THEN a(a,b)=2: GOTO 4420
IF z$="N" THEN a(a,b)=4: GOTO 4420
IF z$="B" THEN a(a,b)=5: GOTO 4420
IF z$="R" THEN a(a,b)=7: GOTO 4420
IF z$="Q" THEN a(a,b)=9: GOTO 4420
GOTO 4360
4420 RETURN
4430 i=-1
GOSUB 4470
GOSUB 2840
RETURN
4470 L=0
FOR j=1 TO 8
FOR k=1 TO 8
L=L+1
IF a(j,k)<>1 THEN c(L)=-a(j,k) ELSE c(L)=a(j,k)
NEXT k
NEXT j
L=65
FOR j=1 TO 8
FOR k=1 TO 8
L=L-1
a(j,k)=c(L)
NEXT k
NEXT j
RETURN
END
pawn:
LINE ((x-1)*55+15,(183-(y-1)*2)*24)-STEP(25,5*2),,bf
LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8*2),,bf
CIRCLE ((x-1)*55+28,(172-(y-1)*24)*2),8
'PAINT ((x-1)*55+28,172-(y-1)*24),4
'CIRCLE ((x-1)*55+28,172-(y-1)*24),8,0
RETURN
rook:
LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5*2),,bf
LINE ((x-1)*55+22,(183-(y-1)*24)*2)-STEP(12,-8*2),,bf
LINE ((x-1)*55+26,(174-(y-1)*24)*2)-STEP(4,-3*2),,bf
LINE ((x-1)*55+16,(174-(y-1)*24)*2)-STEP(4,-3*2),,bf
LINE ((x-1)*55+37,(174-(y-1)*24)*2)-STEP(4,-3*2),,bf
RETURN
bishop:
LINE ((x-1)*55+15,(183-(y-1)*2)*24)-STEP(25,5*2),,bf
LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8*2),,bf
'CIRCLE ((x-1)*55+28,173-(y-1)*24),8,,,,.7
'PAINT ((x-1)*55+28,172-(y-1)*24)
CIRCLE ((x-1)*55+28,(173-(y-1)*24)*2),8,,,,.7
RETURN
queen:
LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5),,bf
LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8),,bf
LINE ((x-1)*55+20,(175-(y-1)*24)*2)-STEP(16,-3),,bf
CIRCLE ((x-1)*55+18,(170-(y-1)*24)*2),3
'PAINT ((x-1)*55+18,170-(y-1)*24)
CIRCLE ((x-1)*55+29,(168-(y-1)*24)*2),3
'PAINT ((x-1)*55+29,168-(y-1)*24)
CIRCLE ((x-1)*55+39,(170-(y-1)*24)*2),3
'PAINT ((x-1)*55+39,170-(y-1)*24)
RETURN
king:
LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5),,bf
LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8),,bf
LINE ((x-1)*55+20,(175-(y-1)*24)*2)-STEP(16,-3),,bf
CIRCLE ((x-1)*55+18,(168-(y-1)*24)*2),3
'PAINT ((x-1)*55+18,168-(y-1)*24)
CIRCLE ((x-1)*55+29,(168-(y-1)*24)*2),3
'PAINT ((x-1)*55+29,168-(y-1)*24)
CIRCLE ((x-1)*55+39,(168-(y-1)*24)*2),3
'PAINT ((x-1)*55+39,168-(y-1)*24)
CIRCLE ((x-1)*55+24,(168-(y-1)*24)*2),7,,3.1415,6.283
CIRCLE ((x-1)*55+34,(168-(y-1)*24)*2),7,,3.1415,6.283
RETURN
knight:
LINE ((x-1)*55+15,(183-(y-1)*24)*2)-STEP(25,5*2),,bf
LINE ((x-1)*55+24,(183-(y-1)*24)*2)-STEP(8,-8*2),,bf
LINE ((x-1)*55+26,(168-(y-1)*24)*2)-STEP(-16,8*2)
LINE STEP(0,0)-STEP(0,2*2)
LINE STEP(0,0)-STEP(3,0)
LINE STEP(0,0)-STEP(7,-1*2)
LINE STEP(0,0)-STEP(15,0)
LINE STEP(0,0)-STEP(0,-9*2)
LINE STEP(0,0)-STEP(-8,0)
'PAINT ((x-1)*55+28,169-(y-1)*24)
CIRCLE ((x-1)*55+26,(172-(y-1)*24)*2),1,0
RETURN